' Frogger Game for CMM2
' Music "9-bit_canon", by Guilio Fazio
' Rev 1.0.0 William M Leue 25-Mar-2024

option default integer
option base 1

' Constants

' Basic dimensions
const HGRID = 40
const VGRID = 40
const NHGRID = mm.hres\HGRID
const NVGRID = mm.vres\VGRID
const ROW_WIDTH = VGRID
const ROW_SPAC = 8

const NSTREAMS  = 10
const NLANDINGS = 3
const NSLOTS    = 5
const SLOTWIDTH = 60
const SLOTSPAC  = 150
const NROWS     = NSTREAMS + NLANDINGS
const T_STREAM  = 1
const T_LANDING = 2
const START_LANDING = NVGRID - 2
const MID_LANDING   = 7
const END_LANDING   = 1
const FIRST_LOG_ROW = 2
const LAST_LOG_ROW  = 6
const FIRST_VEHICLE_ROW = 8
const LAST_VEHICLE_ROW = 12

' Obstacles
const MAX_LOGS     = 30
const MAX_VEHICLES = 30
const C_LOGS       = 1
const C_VEHICLES   = 2

' Row contents indices
const R_TYPE     = 1
const R_CONTENT  = 2
const R_THICK    = 3
const R_COLOR    = 4
const R_SPEED    = 5
const R_NUM      = 6
const R_LENGTH   = 7
const R_SPACING  = 8
const R_NINDICES = 8

' Obstacle content indices
const O_NUM      = 1
const O_ROW      = 2
const O_TOP      = 3
const O_LEFT     = 4
const O_BOTTOM   = 5
const O_RIGHT    = 6
const O_NINDICES = 6

' colors
const SZ_COLOR = rgb(80, 0, 128)
const WT_COLOR = rgb(0, 0, 80)
const LOG_COLOR = rgb(120, 60, 0)
const FROG_COLOR = rgb(green) ' of course!

' Splats
const RSPLAT_NV = 16
const RSPLAT_NREPS = 50

' Commands
const UP    = 128
const DOWN  = 129
const LEFT  = 130
const RIGHT = 131
const HOME  = 134
const F1    = 145
const ESC   = 27

' Art
const NUM_ART       = 3
const SPACING       = 5
const FROG_INDEX    = 1
const SPLAT_INDEX   = 2
const SPLASH_INDEX  = 3
const FROG_WIDTH    = 34
const FROG_HEIGHT   = 29
const SPLAT_WIDTH   = 30
const SPLAT_HEIGHT  = 31
const SPLASH_WIDTH  = 29
const SPLASH_HEIGHT = 22

' Sounds and Music
const MUSIC$ = "8-bit-canon.mp3"
const MUSIC_DURATION = 147000
const MUSIC_WAIT     = MUSIC_DURATION + 20000
const SOUND_SPLAT$   = "splat.wav"
const SOUND_SPLASH$  = "splash.mp3"

' Misc
const START_LIVES = 3
const LABELS_Y = 560
const GS_RUNNING = 0
const GS_WIN     = 1
const GS_LOSE    = 2

' Globals
dim rows(NROWS, R_NINDICES)
dim stream_pos(NROWS)
dim speeds(NROWS)
dim row_y(NROWS)
dim frog_pos(2)
dim frog_death(3)
dim logs(MAX_LOGS, O_NINDICES)
dim nlogs = 0
dim vehicles(MAX_VEHICLES, O_NINDICES)
dim nvehicles = 0
dim first_obstacle_row(NROWS)
dim end_slots_x(NSLOTS)
dim homed(NSLOTS)
dim level = 1
dim nlives = 0
dim running = 0
dim music_playing = 0
dim art_coords(NUM_ART, 2)

' Main Program
open "debug.txt" for output as #1
ReadRowData
LoadArt
ShowTitleScreen
NewGame
DrawBoard
InitFrog
DrawFrog
HandleEvents
end

' Read row parameters
sub ReadRowData
  local i, j, y
  y = 0
  for i = 1 to NROWS
    for j = 1 to R_NINDICES
      read rows(i, j)
    next j
    row_y(i) = y
    inc y, rows(i, R_THICK)
  next i
end sub

' Load art images
sub LoadArt
  local ax = 0
  local ay = 0
  page write 2
  cls
  load BMP "Frogger_Art.bmp", 0, 0
  art_coords(FROG_INDEX, 1) = ax : art_coords(FROG_INDEX, 2) = ay
  inc ax, FROG_WIDTH+SPACING
  art_coords(SPLAT_INDEX, 1) = ax
  art_coords(SPLAT_INDEX, 2) = ay
  inc ax, SPLAT_WIDTH+SPACING
  art_coords(SPLASH_INDEX, 1) = ax
  art_coords(SPLASH_INDEX, 2) = ay
  page write 0
end sub

sub ShowTitleScreen
  local a$
  cls
  load png "Frogger_Title.png", 0, 0
  print @(0, 300) "Need to Read the Rules? (Y, N): ";
  input "", a$
  if left$(UCASE$(a$), 1) = "Y" then ShowHelp
end sub

' Initialize for a new Game
sub NewGame
  local i, rs, alevel
  InitFrog
  for i = 1 to NROWS
    stream_pos(i) = 0
    rs = rows(i, R_SPEED)
    if rs <> 0 then
      alevel = (level-1)\2 + 1
      speeds(i) = rs + sgn(rs)*(level-1)
    else
      speeds(i) = 0
    end if
  next i
  InitObstacles
  if level = 1 then
    nlives = START_LIVES
  end if
  running = 1
  for i = 1 to NSLOTS
    homed(i) = 0
  next i
  music_playing = 1
  PlayMusic
  settick MUSIC_WAIT, PlayMusic
end sub

' Start the background music
sub PlayMusic
  on error skip 1
  play stop
  play mp3 MUSIC$
end sub

' Initialize Obstacles
' Called by NewGame (only)
sub InitObstacles
  local i, j, n, length, spac, s, top, bottom, left, right
  nlogs = 0
  nvehicles = 0
  for i = 1 to NROWS
    first_obstacle_row(i) = 0
    if rows(i, R_TYPE) = T_LANDING then continue for
    top = row_y(i) + ROW_SPAC\2
    bottom = top + rows(i, R_THICK) - ROW_SPAC\2
    length = rows(i, R_LENGTH)*HGRID
    spac = rows(i, R_SPACING)*HGRID
    n = rows(i, R_NUM)
    if rows(i, R_CONTENT) = C_LOGS then
      left = 0
      for j = 1 to n
        inc nlogs
        if first_obstacle_row(i) = 0 then first_obstacle_row(i) = nlogs
        right = left + length
        logs(nlogs, O_NUM) = nlogs
        logs(nlogs, O_ROW) = i
        logs(nlogs, O_TOP) = top
        logs(nlogs, O_BOTTOM) = bottom
        logs(nlogs, O_LEFT) = left
        logs(nlogs, O_RIGHT) = right
        inc left,  length+spac
      next j
    else if rows(i, R_CONTENT) = C_VEHICLES then
      left = 0
      for j = 1 to n
        inc nvehicles
        if first_obstacle_row(i) = 0 then first_obstacle_row(i) = nvehicles
        right = left + length
        vehicles(nvehicles, O_NUM) = nvehicles
        vehicles(nvehicles, O_ROW) = i
        vehicles(nvehicles, O_TOP) = top
        vehicles(nvehicles, O_BOTTOM) = bottom
        vehicles(nvehicles, O_LEFT) = left
        vehicles(nvehicles, O_RIGHT) = right
        inc left, length+spac
      next j
    end if
  next i        
end sub

' Draw the Playing board
sub DrawBoard
  local i, j, x, y
  static nspr = 0
  page write 1
  cls
  box 0, 0, mm.hres, 7*ROW_WIDTH,, WT_COLOR, WT_COLOR
  for i = 1 to NROWS
    y = row_y(i)
    if rows(i, R_TYPE) = T_LANDING then
      box 0, y, mm.hres-1, rows(i, R_THICK),, rows(i, R_COLOR), rows(i, R_COLOR)
      inc y, rows(i, R_THICK) - ROW_SPAC\2
    else
      if (i >= MID_LANDING+2) and (i < START_LANDING) then
        for j = 1 to 5
          x = 4*HGRID*(j-1)
          line x, y, x+2*HGRID, y,, rgb(white)
        next j
      end if
      DrawStream i, y
    end if
    if i = END_LANDING then
      x = SLOTSPAC\2
      for j = 1 to NSLOTS
        x = SLOTSPAC\2 + (j-1)*SLOTSPAC
        box x, rows(i, R_THICK)-SLOTWIDTH, SLOTWIDTH, SLOTWIDTH,, WT_COLOR, WT_COLOR
        end_slots_x(j) = x
        if homed(j) then DrawHomedFrog j
      next j
    end if
  next i
  if frog_death(1) = 0 then
    DrawFrog
  else
    if frog_death(1) = 1 then
      nspr = 0
      frog_death(1) = 2
    end if
    DrawSplat frog_death(2), frog_death(3)
    inc nspr
    if nspr >= RSPLAT_NREPS then
      nspr = 0
      InitFrog
    end if  
  end if
  if running then DrawLabels 0
  page write 0
  page copy 1 to 0, B
end sub

' Draw an Obstacle Stream at its current state
' Also handles Frog collision with vehicles and Frog being scraped
' off a log at screen edges.
' Note: the UpdateStreams routine handles moving the streams and
' wrapping obstacles at the edges.
sub DrawStream row, y
  local w, h, n, i, c, onum
  local top, left, bottom, right
  n = rows(row, R_NUM)
  w = rows(row, R_LENGTH)*HGRID
  h = rows(row, R_THICK) - ROW_SPAC
  c = rows(row, R_COLOR)
  s = speeds(row)
  top = y + ROW_SPAC\2
  bottom = top + h
  for i = 1 to n
    onum = first_obstacle_row(row) + i - 1
    if rows(row, R_CONTENT) = C_LOGS then
      left = logs(onum, O_LEFT)
      right = logs(onum, O_RIGHT)
    else  
      left = vehicles(onum, O_LEFT)
      right = vehicles(onum, O_RIGHT)
    end if
    if row < MID_LANDING then
      DrawLog left, top, w, h, c
    else
      DrawVehicle left, top, w, h, s, c
    end if
    if (row > MID_LANDING) and (frog_pos(2) = row) then
      if IsCollision(onum, row, top, left, bottom, right) then
        HandleMishap row, left
      end if  
    end if
    if frog_pos(2) < MID_LANDING and frog_pos(2) = row then
      if frog_pos(1) = 0 then
        if not FrogOnLog() then HandleMishap row, frog_pos(1)
      end if
      if frog_pos(1) >= mm.hres-1-FROG_WIDTH then 
        if not FrogOnLog() then HandleMishap row, frog_pos(1)
      end if
    end if
  next i
end sub

' Draw a log
sub DrawLog left, top, w, h, c
  rbox left, top, w, h, ROW_WIDTH\2-8, c, c
  circle left+w-ROW_WIDTH\2+4, top+ROW_WIDTH\2-4, ROW_WIDTH\2-6,, 0.8, rgb(yellow), rgb(yellow)
  circle left+w-ROW_WIDTH\2+4, top+ROW_WIDTH\2-4, ROW_WIDTH\2-9,, 0.8, rgb(black)
  circle left+w-ROW_WIDTH\2+4, top+ROW_WIDTH\2-4, ROW_WIDTH\2-15,, 0.8, rgb(black)
end sub

' Draw a vehicle
sub DrawVehicle left, top, w, h, speed, c
  local wsx, rwx, swx, cbx, trx
  if w > 2*HGRID then
    if speed > 0 then
      cbx = left+w-HGRID
      trx = left
    else
      cbx = left
      trx = left+HGRID
    end if
    rbox cbx, top, HGRID, h, 4, rgb(black), rgb(yellow)
    rbox trx, top, w-HGRID, h, 4, c, c
  else
    if speed < 0 then
      wsx = left+20
      rwx = left+w-10
      swx = left+38
    else
      wsx = left+w-30
      rwx = left+10
      swx = left+w-61
    end if
    rbox left, top, w, h, 4, c, c
    rbox wsx, top+3, 15, h-6, 2, rgb(black), rgb(black)
    rbox rwx, top+3, 8, h-6, 2, rgb(black), rgb(black)
    rbox swx, top+2, 28, 3, 1, rgb(black), rgb(black)
    rbox swx, top+h-4, 28, 3, 1, rgb(black), rgb(black)
  end if
end sub
  
' Initialize frog position
' Horizontal position in pixels
' Vertical position in rows (always in an integral row)
sub InitFrog
  frog_pos(1) = (NHGRID\2)*HGRID
  frog_pos(2) = START_LANDING
  frog_death(1) = 0
end sub

' Draw the frog
sub DrawFrog
  local x, y, c
  x = frog_pos(1)
  y = frog_pos(2)*VGRID + ROW_SPAC\2
  blit 0, 0, x, y, FROG_WIDTH, FROG_HEIGHT, 2, &B100
end sub

' Draw the frog in its home slot
sub DrawHomedFrog slot
  local x, y, c, slot_left
  slot_left = end_slots_x(slot)
  x = slot_left + SLOTWIDTH\2 - FROG_WIDTH\2
  y = VGRID + ROW_SPAC\2
  blit 0, 0, x, y, FROG_WIDTH, FROG_HEIGHT, 2, &B100
end sub

' Function to return 1 if the frog is on a log, 0 if not
'   fmode = 0: not a jump
'   fmode = 1: jump
function FrogOnLog(fmode)
  local frow, fleft, fright, n, i, left, right, lnum
  FrogOnLog = 0
  fleft = frog_pos(1) : frow = frog_pos(2)
  fright = fleft + FROG_WIDTH
  if (frow >= MID_LANDING) or (frow = END_LANDING) then exit function
  n = rows(frow, R_NUM)
  for i = 1 to n
    lnum = first_obstacle_row(frow) + i - 1
    left = logs(lnum, O_LEFT)
    right = logs(lnum, O_RIGHT)
    if (fright >= left) and (fright <= right) then
      FrogOnLog = 1
      exit function
    end if
  next i
end function

' Handle Board Update and User Keyboard Events
sub HandleEvents
  local z$, cmd
  z$ = INKEY$
  do
    z$ = INKEY$
    if z$ <> "" then
      cmd = asc(UCASE$(z$))
      select case cmd
        case UP
          MoveFrog UP
        case DOWN
          MoveFrog DOWN
        case LEFT
          MoveFrog LEFT
        case RIGHT
          MoveFrog RIGHT
        case HOME
          NewGame          
        case F1
          if music_playing then
            play stop
            settick 0, PlayMusic
            music_playing = 0
          else
            music_playing = 1
            PlayMusic
            settick MUSIC_WAIT, PlayMusic
          end if
        case ESC
          cls
          end
      end select
    end if
    UpdateStreams
  loop
end sub

' Move the frog
' If in log range and moving up, check for frog not on a log.
' If moving to end landing row, check for frog in a landing slot.
' Moves UP and DOWN are always to an integral row index.
' Moves LEFT and RIGHT are just pixel moves.
sub MoveFrog dir
  local i, j, lflag, slot_left, slot_right
  if not running then exit sub
  select case dir
    case UP
      if frog_pos(2) > END_LANDING then inc frog_pos(2), -1
      if frog_pos(2) = END_LANDING then
        lflag = 0
        for j = 1 to NSLOTS
          if not homed(j) then
            slot_left = end_slots_x(j) : slot_right = slot_left + SLOTWIDTH
            if (frog_pos(1) >= slot_left) and (frog_pos(1) <= slot_right) then
              lflag = j
              exit for
            end if
          end if
        next j
        if lflag then
          homed(lflag) = 1
          DrawHomedFrog lflag
          InitFrog
          CheckForWin
        else
          HandleMishap END_LANDING, frog_pos(1)
        end if
      end if
    case DOWN
      if frog_pos(2) < START_LANDING then inc frog_pos(2)
    case LEFT
      if frog_pos(1) >= HGRID then inc frog_pos(1), -1*HGRID
    case RIGHT
      if frog_pos(1) < mm.hres-1-FROG_WIDTH then inc frog_pos(1), HGRID
  end select
  if (frog_pos(2) < MID_LANDING) and (frog_pos(2) <> END_LANDING) then
    if not FrogOnLog(1) then
      HandleMishap frog_pos(2), frog_pos(1)
    end if
  endif
end sub

' Update all the moving obstacle streams
' Moves streams left or right depending on sign of speed parameter,
' When obstacles disappear off the left or right edge of the screen, they
' reappear on the opposite edge. If the frog is on a log, it moves
' with the log until it hits one of the screen edges.
sub UpdateStreams
  local row, i, n, speed, length, spac, s, left, right, onum
  if not running then exit sub
  for row = 2 to NROWS-1
    if rows(row, R_TYPE) = T_LANDING then continue for
    n      = rows(row, R_NUM)
    length = rows(row, R_LENGTH)*HGRID
    speed  = speeds(row)
    spac   = rows(row, R_SPACING)
    s      = stream_pos(row)
    inc s, speed
    if rows(row, R_CONTENT) = C_LOGS then
      for i = 1 to n
        onum = first_obstacle_row(row) + i - 1
        left = logs(onum, O_LEFT) + s
        right = logs(onum, O_RIGHT) + s
        if speed > 0 then
          if left >= mm.hres-1 then
            right = 0
            left = right-length
          end if
        else
          if right <= 0 then
            left = mm.hres-1
            right = left+length
          end if
        end if
        logs(onum, O_LEFT) = left
        logs(onum, O_RIGHT) = right
      next i
    else
      for i = 1 to n
        onum = first_obstacle_row(row) + i - 1
        left = vehicles(onum, O_LEFT) + s
        right = vehicles(onum, O_RIGHT) + s
        if speed > 0 then
          if left >= mm.hres-1 then
            right = 0
            left = right - length
          end if
        else
          if right <= 0 then
            left = mm.hres-1
            right = left+length
          end if
        end if
        vehicles(onum, O_LEFT) = left
        vehicles(onum, O_RIGHT) = right
      next i
    end if  
  next row
  if FrogOnLog(0) then
    speed = speeds(frog_pos(2))
    inc frog_pos(1), speed
    if frog_pos(1) < 0 then frog_pos(1) = 0
    if frog_pos(1) > mm.hres-1-FROG_WIDTH then
      frog_pos(1) = mm.hres-1-FROG_WIDTH
    endif
  end if
  DrawBoard
end sub

' Returns 1 if there is a collision between the
' Frog rectangle and an obstacle rectangle. Since we know the
' row index, we only need to check the X position to detect a collision.
' This function is only used to check Frog collisions with vehicles.
function IsCollision(which, row, rtop, rleft, rbottom, rright)
  local ftop, fleft, fbottom, fright, collision
  collision = 1
  if frog_pos(2) <= MID_LANDING then
    IsCollision = 0
    exit function
  end if
  fleft = frog_pos(1) : fright = fleft + FROG_WIDTH
  if (fleft > rright) or (fright < rleft) then
    collision = 0
  end if
  IsCollision = collision
end function

' Handle a Frog Mishap: A vehicle collision or a missed log
sub HandleMishap row, x
  if frog_death(1) = 2 then exit sub
  inc nlives, -1
  frog_death(1) = 1
  frog_death(2) = row
  frog_death(3) = x
  if nlives <= 0 then
    running = 0
    DrawLabels GS_LOSE
    play stop
  else
    DrawFrog
  end if
end sub

' Add a visual mark where the frog died
sub DrawSplat row, x
  local px, py, sx, sy, w, h
  local y = row_y(row) + ROW_WIDTH\2
  if row > MID_LANDING then
    px = art_coords(SPLAT_INDEX, 1)
    py = art_coords(SPLAT_INDEX, 2)
    sx = x
    w = SPLAT_WIDTH
    h = SPLAT_HEIGHT
    sy = y - h\2
  else
    px = art_coords(SPLASH_INDEX, 1)
    py = art_coords(SPLASH_INDEX, 2)
    sx = x
    w = SPLASH_WIDTH
    h = SPLASH_HEIGHT
    sy = y - h\2
  end if
  blit px, py, sx, sy, w, h, 2, &B100
'  PlaySoundEffect row
end sub

' Play a sound effect when the frog dies
sub PlaySoundEffect row
  play pause
  if row > MID_LANDING then
    play wav SOUND_SPLAT$
  else
    play mp3 SOUND_SPLASH$
  end if
  play resume
end sub

' Draw the Level and Lives labels at the bottom
' which: GS_RUNNING: in a game, GS_WIN = Won game, GS_LOSE = lost game
sub DrawLabels which
  if running then
    m$ = "LEVEL " + str$(level)
    text 40, LABELS_Y+5, m$, "LT", 5
    m$ = "LIVES " + str$(nlives)
    text mm.hres-40, LABELS_Y+5, m$, "RT", 5
  else
    box 0, LABELS_Y+1, mm.hres, 40,, rgb(black), rgb(black)
    if which = GS_LOSE then
      text mm.hres\2, LABELS_Y+5, "GAME_OVER - Press Home for New Game", "CT", 4,, rgb(red)
    else if which = GS_WIN then
      text mm.hres\2, LABELS_Y+5, "YOU WIN! - Press Home for Next Level", "CT", 4,, rgb(green)
    end if
  end if
end sub

' Check for all 5 home slots filled and if so its a win!
' Notify user, maybe bump lives.
sub CheckForWin
  local i, n
  n = 0
  for i = 1 to NSLOTS
    if homed(i) then inc n
  next i
  if n = 5 then
    running = 0
    inc level
    if (level > 1) and (level mod 2) = 1) then inc nlives
    DrawLabels GS_WIN
  end if
end sub

' Help
sub ShowHelp
  local m$ = INKEY$
  cls
  text mm.hres\2, 0, "Frogger Help", "CT", 4,, rgb(green)
  print @(0, 40) ""
  print "This is a version of the classic 'Frogger' game for the CMM2."
  print ""
  print "Your goal is to get 5 frogs from their start position at the bottom of the board"
  print "To their homes at the top of the board. To accomplish this, the frogs must first"
  print "cross a busy highway, and then hop from log to log to safely cross a wide and"
  print "deep river. Any mistake with either peril will cause the frog to die."
  print ""
  print "You initially get 3 lives. If you successfully get 5 frogs across to their home"
  print "slots at the top of the board, you complete a level. You gain 1 life every two"
  print "completed levels. Natually, successive levels get harder. If you run out of lives,"
  print "the game is over."
  print ""
  print "To move the frog, use the arrow keys on the keyboard. To start a new game, press"
  print "the Home key. To toggle the game music off or back on, press the F1 key."
  print "To quit the program, press the Escape key."
  print ""
  print "The music was written by Guilio Fazio, and is used by permission."
  print ""
  text mm.hres\2, 400, "Press Any Key to Continue", "CT"
  do
    m$ = INKEY$
  loop until m$ <> ""
end sub

' Describe the rows from top to bottom
'    R_TYPE,    R_CONTENT,  R_THICK,   R_COLOR,     R_SPEED, R_NUM, R_LENGTH, R_SPACING
data T_LANDING, 0,          2*VGRID,   rgb(green),  0,       0,     3,        1
data T_STREAM,  C_LOGS,     ROW_WIDTH, LOG_COLOR,   2,       3,     2,        5
data T_STREAM,  C_LOGS,     ROW_WIDTH, LOG_COLOR,  -4,       3,     4,        4
data T_STREAM,  C_LOGS,     ROW_WIDTH, LOG_COLOR,   5,       3,     5,        2
data T_STREAM,  C_LOGS,     ROW_WIDTH, LOG_COLOR,   2,       4,     2,        6
data T_STREAM,  C_LOGS,     ROW_WIDTH, LOG_COLOR,  -3,       4,     3,        2
data T_LANDING, 0,          VGRID,     SZ_COLOR,    0,       0,     0,        0
data T_STREAM,  C_VEHICLES, ROW_WIDTH, rgb(white), -4,       2,     4,        6
data T_STREAM,  C_VEHICLES, ROW_WIDTH, rgb(green),  2,       3,     2,        7
data T_STREAM,  C_VEHICLES, ROW_WIDTH, rgb(blue),  -3,       3,     2,        5
data T_STREAM,  C_VEHICLES, ROW_WIDTH, rgb(cyan),   3,       3,     2,        7
data T_STREAM,  C_VEHICLES, ROW_WIDTH, rgb(gold),  -2,       4,     2,        3
data T_LANDING, 0,          VGRID,     SZ_COLOR,    0,       0,     0,        0

' ========= end of source code ============

